home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 2010 April / PCWorld0410.iso / hity wydania / Ubuntu 9.10 PL / karmelkowy-koliberek-desktop-9.10-i386-PL.iso / casper / filesystem.squashfs / usr / bin / cpan < prev    next >
Text File  |  2009-10-01  |  12KB  |  471 lines
  1. #!/usr/bin/perl
  2.     eval 'exec /usr/bin/perl -S $0 ${1+"$@"}'
  3.     if $running_under_some_shell;
  4. #!/usr/bin/perl
  5. # $Id: cpan,v 1.9 2006/11/01 21:49:31 comdog Exp $
  6. use strict;
  7.  
  8. =head1 NAME
  9.  
  10. cpan - easily interact with CPAN from the command line
  11.  
  12. =head1 SYNOPSIS
  13.  
  14.     # with arguments and no switches, installs specified modules
  15.     cpan module_name [ module_name ... ]
  16.  
  17.     # with switches, installs modules with extra behavior
  18.     cpan [-cfimt] module_name [ module_name ... ]
  19.  
  20.     # without arguments, starts CPAN.pm shell
  21.     cpan
  22.  
  23.     # without arguments, but some switches
  24.     cpan [-ahrvACDLO]
  25.  
  26. =head1 DESCRIPTION
  27.  
  28. This script provides a command interface (not a shell) to CPAN. At the
  29. moment it uses CPAN.pm to do the work, but it is not a one-shot command
  30. runner for CPAN.pm.
  31.  
  32. =head2 Meta Options
  33.  
  34. These options are mutually exclusive, and the script processes them in
  35. this order: [hvCAar].  Once the script finds one, it ignores the others,
  36. and then exits after it finishes the task.  The script ignores any other
  37. command line options.
  38.  
  39. =over 4
  40.  
  41. =item -a
  42.  
  43. Creates the CPAN.pm autobundle with CPAN::Shell->autobundle.
  44.  
  45. =item -A module [ module ... ]
  46.  
  47. Shows the primary maintainers for the specified modules
  48.  
  49. =item -C module [ module ... ]
  50.  
  51. Show the C<Changes> files for the specified modules
  52.  
  53. =item -D module [ module ... ]
  54.  
  55. Show the module details. This prints one line for each out-of-date module
  56. (meaning, modules locally installed but have newer versions on CPAN).
  57. Each line has three columns: module name, local version, and CPAN
  58. version.
  59.  
  60. =item -L author [ author ... ]
  61.  
  62. List the modules by the specified authors.
  63.  
  64. =item -h
  65.  
  66. Prints a help message.
  67.  
  68. =item -O
  69.  
  70. Show the out-of-date modules.
  71.  
  72. =item -r
  73.  
  74. Recompiles dynamically loaded modules with CPAN::Shell->recompile.
  75.  
  76. =item -v
  77.  
  78. Print the script version and CPAN.pm version.
  79.  
  80. =back
  81.  
  82. =head2 Module options
  83.  
  84. These options are mutually exclusive, and the script processes them in
  85. alphabetical order. It only processes the first one it finds.
  86.  
  87. =over 4
  88.  
  89. =item c
  90.  
  91. Runs a `make clean` in the specified module's directories.
  92.  
  93. =item f
  94.  
  95. Forces the specified action, when it normally would have failed.
  96.  
  97. =item i
  98.  
  99. Installed the specified modules.
  100.  
  101. =item m
  102.  
  103. Makes the specified modules.
  104.  
  105. =item t
  106.  
  107. Runs a `make test` on the specified modules.
  108.  
  109. =back
  110.  
  111. =head2 Examples
  112.  
  113.     # print a help message
  114.     cpan -h
  115.  
  116.     # print the version numbers
  117.     cpan -v
  118.  
  119.     # create an autobundle
  120.     cpan -a
  121.  
  122.     # recompile modules
  123.     cpan -r
  124.  
  125.     # install modules ( sole -i is optional )
  126.     cpan -i Netscape::Booksmarks Business::ISBN
  127.  
  128.     # force install modules ( must use -i )
  129.     cpan -fi CGI::Minimal URI
  130.  
  131. =head1 TO DO
  132.  
  133.  
  134. =head1 BUGS
  135.  
  136. * none noted
  137.  
  138. =head1 SEE ALSO
  139.  
  140. Most behaviour, including environment variables and configuration,
  141. comes directly from CPAN.pm.
  142.  
  143. =head1 SOURCE AVAILABILITY
  144.  
  145. This source is part of a SourceForge project which always has the
  146. latest sources in CVS, as well as all of the previous releases.
  147.  
  148.     http://sourceforge.net/projects/brian-d-foy/
  149.  
  150. If, for some reason, I disappear from the world, one of the other
  151. members of the project can shepherd this module appropriately.
  152.  
  153. =head1 CREDITS
  154.  
  155. Japheth Cleaver added the bits to allow a forced install (-f).
  156.  
  157. Jim Brandt suggest and provided the initial implementation for the
  158. up-to-date and Changes features.
  159.  
  160. Adam Kennedy pointed out that exit() causes problems on Windows
  161. where this script ends up with a .bat extension
  162.  
  163. =head1 AUTHOR
  164.  
  165. brian d foy, C<< <bdfoy@cpan.org> >>
  166.  
  167. =head1 COPYRIGHT
  168.  
  169. Copyright (c) 2001-2006, brian d foy, All Rights Reserved.
  170.  
  171. You may redistribute this under the same terms as Perl itself.
  172.  
  173. =cut
  174.  
  175. use CPAN ();
  176. use Getopt::Std;
  177.  
  178. my $VERSION =
  179.     sprintf "%d.%d", q$Revision: 1.9 $ =~ m/ (\d+) \. (\d+) /xg;
  180.  
  181. if( $ARGV[0] eq 'install' )
  182.     {
  183.     my @args = @ARGV;
  184.     shift @args;
  185.     
  186.     die <<"HERE";
  187. It looks like you specified 'install' as an argument to cpan(1). This
  188. script is not the CPAN.pm prompt and doesn't understand the same commands.
  189. In fact, doesn't require the extra typing. You probably just want to
  190. list the modules you want to install:
  191.  
  192.     cpan @args
  193.     
  194. See the documentation for more details on using this script.
  195. HERE
  196.     }
  197.     
  198. if( 0 == @ARGV ) { CPAN::shell(); exit 0 }
  199.  
  200. # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # 
  201. # set up the order of options that we layer over CPAN::Shell
  202. my @META_OPTIONS = qw( h v C A D O L a r );
  203.  
  204. # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # 
  205. # map switches to method names in CPAN::Shell
  206. my $Default = 'default';
  207.  
  208. my %CPAN_METHODS = (
  209.     $Default => 'install',
  210.     'c'      => 'clean',
  211.     'f'      => 'force',
  212.     'i'      => 'install',
  213.     'm'      => 'make',
  214.     't'      => 'test',
  215.     );
  216. my @CPAN_OPTIONS = grep { $_ ne $Default } sort keys %CPAN_METHODS;
  217.  
  218. # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # 
  219. # map switches to the subroutines in this script, along with other information.
  220. # use this stuff instead of hard-coded indices and values
  221. my %Method_table = (
  222. # key => [ sub ref, takes args?, exit value, description ]
  223.     h => [ \&_print_help,        0, 0, 'Printing help'          ],
  224.     v => [ \&_print_version,     0, 0, 'Printing version'       ],
  225.     C => [ \&_show_Changes,      1, 0, 'Showing Changes file'   ],
  226.     A => [ \&_show_Author,       1, 0, 'Showing Author'         ],
  227.     D => [ \&_show_Details,      1, 0, 'Showing Details'        ],
  228.     O => [ \&_show_out_of_date,  0, 0, 'Showing Out of date'    ],
  229.     L => [ \&_show_author_mods,  1, 0, 'Showing author mods'    ],
  230.     a => [ \&_create_autobundle, 0, 0, 'Creating autobundle'    ],
  231.     r => [ \&_recompile,         0, 0, 'Recompiling'            ],
  232.  
  233.     c => [ \&_default,           1, 0, 'Running `make clean`'   ],
  234.     f => [ \&_default,           1, 0, 'Installing with force'  ],
  235.     i => [ \&_default,           1, 0, 'Running `make install`' ],
  236.    'm' => [ \&_default,          1, 0, 'Running `make`'         ],
  237.     t => [ \&_default,           1, 0, 'Running `make test`'    ],
  238.  
  239.     );
  240.  
  241. my %Method_table_index = (
  242.     code        => 0,
  243.     takes_args  => 1,
  244.     exit_value  => 2,
  245.     description => 3,
  246.     );
  247.     
  248. # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # 
  249. # finally, do some argument processing
  250. my @option_order = ( @META_OPTIONS, @CPAN_OPTIONS );
  251.  
  252. my %options;
  253. Getopt::Std::getopts(
  254.     join( '', @option_order ), \%options );
  255.  
  256. my $option_count = grep { $options{$_} } @option_order;
  257. $option_count -= $options{'f'}; # don't count force
  258.  
  259. # if there are no options, set -i (this line fixes RT ticket 16915)
  260. $options{i}++ unless $option_count;
  261.  
  262. # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # 
  263. # try each of the possible switches until we find one to handle
  264. # print an error message if there are too many switches
  265. # print an error message if there are arguments when there shouldn't be any
  266. foreach my $option ( @option_order )
  267.     {
  268.     next unless $options{$option};
  269.     die unless 
  270.         ref $Method_table{$option}[ $Method_table_index{code} ] eq ref sub {};
  271.     
  272.     print "$Method_table{$option}[ $Method_table_index{description} ] " .
  273.         "-- ignoring other opitions\n" if $option_count > 1;
  274.     print "$Method_table{$option}[ $Method_table_index{description} ] " .
  275.         "-- ignoring other arguments\n" 
  276.         if( @ARGV && ! $Method_table{$option}[ $Method_table_index{takes_args} ] );
  277.         
  278.     $Method_table{$option}[ $Method_table_index{code} ]->( \@ARGV );
  279.     
  280.     last;
  281.     }
  282.  
  283. # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # 
  284.  # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # 
  285. # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # 
  286.  
  287. sub _default
  288.     {
  289.     my $args = shift;
  290.     
  291.     my $switch = '';
  292.  
  293.     # choose the option that we're going to use
  294.     # we'll deal with 'f' (force) later, so skip it
  295.     foreach my $option ( @CPAN_OPTIONS )
  296.         {
  297.         next if $option eq 'f';
  298.         next unless $options{$option};
  299.         $switch = $option;
  300.         last;
  301.         }
  302.  
  303.     # 1. with no switches, but arguments, use the default switch (install)
  304.     # 2. with no switches and no args, start the shell
  305.     # 3. With a switch but no args, die! These switches need arguments.
  306.        if( not $switch and     @$args ) { $switch = $Default;     }
  307.     elsif( not $switch and not @$args ) { CPAN::shell(); return   }
  308.     elsif(     $switch and not @$args )
  309.         { die "Nothing to $CPAN_METHODS{$switch}!\n"; }
  310.  
  311.     # Get and cheeck the method from CPAN::Shell
  312.     my $method = $CPAN_METHODS{$switch};
  313.     die "CPAN.pm cannot $method!\n" unless CPAN::Shell->can( $method );
  314.  
  315.     # call the CPAN::Shell method, with force if specified
  316.     foreach my $arg ( @$args )
  317.         {
  318.         if( $options{f} ) { CPAN::Shell->force( $method, $arg ) }
  319.         else              { CPAN::Shell->$method( $arg )        }
  320.         }
  321.     }
  322.  
  323. # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # 
  324. sub _print_help
  325.     {
  326.     print STDERR "Use perldoc to read the documentation\n";
  327.     exec "perldoc $0";
  328.     }
  329.     
  330. sub _print_version
  331.     {
  332.     print STDERR "$0 script version $VERSION, CPAN.pm version " . 
  333.         CPAN->VERSION . "\n";
  334.     }
  335.     
  336. sub _create_autobundle
  337.     {
  338.     print "Creating autobundle in ", $CPAN::Config->{cpan_home},
  339.         "/Bundle\n";
  340.  
  341.     CPAN::Shell->autobundle;
  342.     }
  343.  
  344. sub _recompile
  345.     {
  346.     print "Recompiling dynamically-loaded extensions\n";
  347.  
  348.     CPAN::Shell->recompile;
  349.     }
  350.  
  351. sub _show_Changes
  352.     {
  353.     my $args = shift;
  354.     
  355.     foreach my $arg ( @$args )
  356.         {
  357.         print "Checking $arg\n";
  358.         my $module = CPAN::Shell->expand( "Module", $arg );
  359.         
  360.         next unless $module->inst_file;
  361.         #next if $module->uptodate;
  362.     
  363.         ( my $id = $module->id() ) =~ s/::/\-/;
  364.     
  365.         my $url = "http://search.cpan.org/~" . lc( $module->userid ) . "/" .
  366.             $id . "-" . $module->cpan_version() . "/";
  367.     
  368.         #print "URL: $url\n";
  369.         _get_changes_file($url);
  370.         }
  371.     }    
  372.     
  373. sub _get_changes_file
  374.     {
  375.     die "Reading Changes files requires LWP::Simple and URI\n"
  376.         unless eval { require LWP::Simple; require URI; };
  377.     
  378.     my $url = shift;
  379.  
  380.     my $content = LWP::Simple::get( $url );
  381.     print "Got $url ...\n" if defined $content;
  382.     #print $content;
  383.     
  384.     my( $change_link ) = $content =~ m|<a href="(.*?)">Changes</a>|gi;
  385.     
  386.     my $changes_url = URI->new_abs( $change_link, $url );
  387.      #print "change link is: $changes_url\n";
  388.     my $changes =  LWP::Simple::get( $changes_url );
  389.     #print "change text is: " . $change_link->text() . "\n";
  390.     print $changes;
  391.     }
  392.     
  393. sub _show_Author
  394.     {
  395.     my $args = shift;
  396.     
  397.     foreach my $arg ( @$args )
  398.         {
  399.         my $module = CPAN::Shell->expand( "Module", $arg );
  400.         my $author = CPAN::Shell->expand( "Author", $module->userid );
  401.     
  402.         next unless $module->userid;
  403.     
  404.         printf "%-25s %-8s %-25s %s\n", 
  405.             $arg, $module->userid, $author->email, $author->fullname;
  406.         }
  407.     }    
  408.  
  409. sub _show_Details
  410.     {
  411.     my $args = shift;
  412.     
  413.     foreach my $arg ( @$args )
  414.         {
  415.         my $module = CPAN::Shell->expand( "Module", $arg );
  416.         my $author = CPAN::Shell->expand( "Author", $module->userid );
  417.     
  418.         next unless $module->userid;
  419.     
  420.         print "$arg\n", "-" x 73, "\n\t";
  421.         print join "\n\t",
  422.             $module->description ? $module->description : "(no description)",
  423.             $module->cpan_file,
  424.             $module->inst_file,
  425.             'Installed: ' . $module->inst_version,
  426.             'CPAN:      ' . $module->cpan_version . '  ' .
  427.                 ($module->uptodate ? "" : "Not ") . "up to date",
  428.             $author->fullname . " (" . $module->userid . ")",
  429.             $author->email;
  430.         print "\n\n";
  431.         
  432.         }
  433.     }    
  434.  
  435. sub _show_out_of_date
  436.     {
  437.     my @modules = CPAN::Shell->expand( "Module", "/./" );
  438.         
  439.     printf "%-40s  %6s  %6s\n", "Module Name", "Local", "CPAN";
  440.     print "-" x 73, "\n";
  441.     
  442.     foreach my $module ( @modules )
  443.         {
  444.         next unless $module->inst_file;
  445.         next if $module->uptodate;
  446.         printf "%-40s  %.4f  %.4f\n",
  447.             $module->id, 
  448.             $module->inst_version ? $module->inst_version : '', 
  449.             $module->cpan_version;
  450.         }
  451.  
  452.     }
  453.  
  454. sub _show_author_mods
  455.     {
  456.     my $args = shift;
  457.  
  458.     my %hash = map { lc $_, 1 } @$args;
  459.     
  460.     my @modules = CPAN::Shell->expand( "Module", "/./" );
  461.     
  462.     foreach my $module ( @modules )
  463.         {
  464.         next unless exists $hash{ lc $module->userid };
  465.         print $module->id, "\n";
  466.         }
  467.     
  468.     }
  469.     
  470. 1;
  471.